home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
dskut
/
xlat11.zip
/
CONFXLAT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-08-12
|
37KB
|
1,112 lines
Program confxlat;
{ Customize a XLAT(R).COM programme }
{ FreeWare by TapirSoft Gisbert W.Selke, Oct 1989/Aug 1990 }
{$UNDEF DEBUG } { DEFINE while debugging }
{$A+,B-,D+,E+,F-,I+,L+,N-,O-,V- }
{$M 16384,0,16384 }
{$IFDEF DEBUG }
{$R+,S+ }
{$ELSE }
{$R-,S- }
{$ENDIF }
Uses Dos, Crt;
Const progname = 'ConfXlat';
version = '1.1';
copyright = 'FreeWare by TapirSoft Gisbert W.Selke, Oct 1989/Aug 1990';
idstring10= 'XLAT10';
idstring11= 'XLAT11';
idlength = Length(idstring10);
hexnibble : string[16] = '0123456789ABCDEF';
digits : string[10] = '0123456789';
Const fbufsize = 4096;
width = 18;
videoint = $10;
blockcur = $010C; { normcur defined dynamically! }
nocur = $2B0C;
F1 = #59; F2 = #60;
F3 = #61; F4 = #62;
F5 = #63; F6 = #64;
F7 = #65; F8 = #66;
F9 = #67; F10 = #68;
CtrlC = #3; Esc = #27;
Return = #13;
Home = #71; UpAr = #72;
PgUp = #73; LfAr = #75;
RtAr = #77; EndK = #79;
DnAr = #80; PgDn = #81;
Ins = #82; Del = #83;
CHome = #119; CEndK = #117;
Type tabletype = Array [byte] Of byte;
Var fname : string;
xlat : File;
tabf : text;
fbuf : Array [1..fbufsize] Of byte;
fsize : word;
descript, intername : string;
tstart, tabstart, interstart : word;
desclen : byte;
xlatid : byte;
table : tabletype;
changed, floaded : boolean;
ch : char;
maxlin, maxcol : byte;
row : byte;
col, leftcol : integer;
normcur : word;
exitsave : Pointer;
Function hexbyte(b : byte) : string;
{ convert a byte to a string }
Begin { hexbyte }
hexbyte := hexnibble[Succ(b ShR 4)] + hexnibble[Succ(b And $0F)];
End; { hexbtye }
Procedure beep;
{ error noise }
Begin { beep }
Sound(440);
Delay(100);
NoSound;
End; { beep }
Procedure putchar(b : byte);
{ show a character on the screen, without interpreting control chars }
Inline($B4/$0F/ {Mov ah, $0F ; get current video mode }
$CD/$10/ {Int $10 ; in bh }
$58/ {Pop ax ; get char in al }
$B4/$0A/ {Mov ah, $0A ; output char }
$B3/$70/ {Mov bl, $70 ; white on black }
$B9/$01/$00/ {Mov cx, $01 ; just one copy }
$CD/$10); {Int $10 }
Procedure setcursor(curtype : word);
{ set cursor start and end line and blink bits }
Var regs : Registers;
Begin { setcursor }
With regs Do
Begin
ah := $0F;
Intr(videoint,regs);
cx := curtype;
ah := $01;
Intr(videoint,regs);
End;
End; { setcursor }
Procedure getcursor;
{ get cursor start and end line and blink bits, put them into normcur }
Var regs : Registers;
Begin { setcursor }
With regs Do
Begin
ah := $0F;
Intr(videoint,regs);
ah := $03;
Intr(videoint,regs);
normcur := cx;
End;
End; { setcursor }
Procedure moreprompt;
{ wait for key press at bottom of 'list' window }
Var ch : char;
Begin { moreprompt }
GoToXY(maxcol-25,8);
write('Hit space bar...');
ch := ReadKey;
While KeyPressed Do ch := ReadKey;
GoToXY(1,8);
ClrEoL;
End; { moreprompt }
Procedure openlistwindow;
{ open a window in central part of screen }
Var i : byte;
Begin { openlistwindow }
Window(1,11,maxcol,20);
ClrScr;
GoToXY(2,1);
write(#218);
For i := 3 To 78 Do write(#196);
write(#191);
For i := 2 To 9 Do
Begin
GoToXY(2,i);
write(#179);
GoToXY(79,i);
write(#179);
End;
GoToXY(2,10);
write(#192);
For i := 3 To 78 Do write(#196);
write(#217);
Window(4,12,maxcol-4,19);
End; { openlistwindow }
Procedure errmsg(s : string);
{ display an error message }
Var i : byte;
ch : char;
Begin { errmsg }
SetCursor(nocur);
Window(1,11,maxcol,13);
ClrScr;
GoToXY(1,1);
write(#218);
For i := 1 To Length(s)+2 Do write(#196);
write(#191);
GoToXY(1,2);
write(#179,' ',s,' ',#179);
GoToXY(1,3);
write(#192);
For i := 1 To Length(s)+2 Do write(#196);
write(#217);
While KeyPressed Do ch := ReadKey;
ch := ReadKey;
While KeyPressed Do ch := ReadKey;
ClrScr;
Window(1,1,maxcol,maxlin);
SetCursor(normcur);
End; { errmsg }
Function showfiles(mask : string) : boolean;
{ if mask contains wildcards, show all files that match, then return True }
Var wild : boolean;
i, linct, colct : byte;
sr : SearchRec;
Begin { showfiles }
wild := False;
For i := 1 To Length(mask) Do wild := wild Or (mask[i] = '?') Or
(mask[i] = '*');
showfiles := wild;
If Not wild Then Exit;
openlistwindow;
FindFirst(mask,Archive+ReadOnly+Hidden,sr);
linct := 0;
colct := 0;
wild := False;
While DosError = 0 Do
Begin
wild := True;
i := Pos('.',sr.name);
write(' ':(10-i),sr.name,' ':(4-Length(sr.name)+i));
Inc(colct);
If colct >= 5 Then
Begin
writeln;
Inc(linct);
If linct >= 7 Then
Begin
moreprompt;
linct := 0;
End;
colct := 0;
End;
FindNext(sr);
End;
If Not wild Then
Begin
writeln('No files matching "',mask,'"');
linct := 1;
End;
If (linct > 0) Or (colct > 0) Then
Begin
writeln;
moreprompt;
End;
Window(1,11,maxcol,20);
ClrScr;
Window(1,1,maxcol,maxlin);
End; { showfiles }
Procedure initdisplay;
{ initialize display }
Var i : byte;
Begin { initdisplay }
Window(1,1,maxcol,maxlin);
ClrScr;
GoToXY(3,1);
write('Internal name: ',intername);
Case xlatid Of
10 : write(' (filter)');
11 : write(' (resident)');
Else ;
End;
While (descript <> '') And (descript[Length(descript)] = ' ') Do
Delete(descript,Len